home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / PPCon68k < prev    next >
Text File  |  1998-06-22  |  9KB  |  380 lines
  1. need struct1
  2. need bytestring
  3.  
  4. (*
  5. This is a prolog file to load on the 68k Mops, before loading the PPC
  6. code generator.  It defines some PPC-specific words in a way that will
  7. allow the code generator to load and run on the 68k, and hopefully
  8. produce proper PPC code.
  9. *)
  10.  
  11. : TO_BE_WRITTEN        79 die  ;    ¥ put wherever code isn't written yet
  12.  
  13. : UWITHIN?    ¥ ( u lo hi -- u b )  An unsigned version of WITHIN?
  14.     rot tuck u>= down tuck u<= rot and  ;
  15.  
  16.  
  17. : ALIGN4
  18.     DP
  19.     4 reserve            ¥ just to ensure pad bytes are zero
  20.     3 +  $ fffffffc and  -> DP
  21. ;
  22.  
  23. : ALIGN8
  24.     DP
  25.     8 reserve
  26.     7 +  $ fffffff8 and  -> DP
  27. ;
  28.  
  29. : #ALIGN2  ( n -- n' )    1+  -2 and  ;
  30. : #ALIGN4  ( n -- n' )    3 +  -4 and  ;
  31. : #ALIGN8    7 +  $ fffffff8 and  ;
  32.  
  33. : ALIGNED    #align4  ;            ¥ 4-byte alignment is our default on the PPC
  34.                                 ¥ ( ALIGNED is ANSI )
  35.  
  36. : #ALIGN16  ( n -- n' )  15 +  $ fffffff0 and  ;
  37.  
  38. : #OFF-ALIGN    ¥ ( n -- n' )  Aligns to the next 2-byte boundary between
  39.                 ¥  adjacent 4-byte boundaries.
  40.     5 + $ fffffffc and 2-  ;
  41.  
  42.  
  43. : code_allot    ++> CDP  ;
  44. : code_reserve    CDP over erase  ++> CDP  ;
  45. : code_align    CDP 4 erase  CDP #align4  -> CDP  ;
  46.  
  47.  
  48. ¥    ================== REGISTER DEFINITIONS  ===================
  49.  
  50. ¥ r0 is scratch
  51.  
  52. 1    constant    sys_SP_reg
  53. 2    constant    RTOC_reg
  54. 10    constant    rZ_reg
  55. 11    constant    rX_reg
  56. 12    constant    rY_reg
  57. 13    constant    mainCode_reg
  58. 14    constant    mainData_reg
  59. 15    constant    modCode_reg
  60. 16    constant    modData_reg
  61. 17    constant    RP_reg
  62. 18    constant    SP_reg
  63. 19    constant    FSP_reg
  64. 20    constant    obj_base_reg
  65. 21    constant    I_reg            ¥ can be used for a local if no DO...LOOP
  66.                                 ¥  or FOR...NEXT
  67. 22    constant    do_limit_reg    ¥ can be used for a local if no DO..LOOP
  68.  
  69. 21    constant    1st_gpr_local
  70. 14    constant    1st_fpr_local
  71.  
  72.  
  73. ¥ Here are some values which are ref'd in a few places in the code
  74. ¥  generator but aren't actually needed in the target compilation.
  75. ¥  THe real definitions are in pnuc1.  Defining them here saves us
  76. ¥  putting conditional compilation in a lot of places.
  77.  
  78.     0    value    #FP            ¥ ref'd in cg3 and cg5
  79.     0    value    #FPL
  80.     
  81.     0    value    CD_gpr#
  82.  
  83.  
  84.  
  85. ¥    ====================  ADDRESSING  =====================
  86.  
  87.  
  88. 65520    constant    DISPL_RANGE            ¥ what we can fit in a signed 16-bits
  89.                                         ¥  displacement, rounded down to
  90.                                         ¥  8-byte alignment
  91. 32760    constant    HALF_DISPL_RANGE
  92.  
  93.  
  94. ¥ code_start and seg_code_start are now in Nuc.asm so that the 68k (findM) can
  95. ¥  use them when in encounters a PPC-style reloc addr.
  96.  
  97.     0    value    code_limit
  98.     0    value    nuc_code_start
  99.     0    value    data_start
  100.     0    value    nuc_data_start
  101.     0    value    data_limit
  102.  
  103.     0    value    seg_code_limit
  104.     0    value    seg_data_start
  105.     0    value    seg_data_limit
  106.  
  107. ¥ These words give the PPC base reg values while we're target compiling:
  108.  
  109. : mainCode_val    nuc_code_start    half_displ_range +  ;
  110. : mainData_val    nuc_data_start    half_displ_range +  ;
  111. : modCode_val    seg_code_start    half_displ_range +  ;
  112. : modData_val    seg_data_start    half_displ_range +  ;
  113.  
  114.  
  115.  
  116. 0    value    comp_seg#        ¥ zero unless we're compiling a separate segment
  117.                             ¥  in which case it's the seg# we're compiling
  118.                             ¥  (currently this can only be 10)
  119.  
  120.  
  121. : addr>S&D  { addr --  seg# displ }
  122.     comp_seg#
  123.     IF
  124.         addr
  125.         seg_code_start  seg_code_limit
  126.         uwithin?
  127.         IF                ¥ found!
  128.             seg_code_start -  comp_seg#  swap  EXIT
  129.         THEN
  130.     ( addr )
  131.         seg_data_start  seg_data_limit
  132.         uwithin?
  133.         IF        seg_data_start -  comp_seg# 1+ swap  EXIT
  134.         THEN    drop
  135.     THEN
  136.  
  137.     addr
  138.     code_start  code_limit
  139.     uwithin?
  140.     IF    code_start -  8 swap  EXIT
  141.     THEN
  142.  
  143.   ( addr )
  144.       data_start  data_limit
  145.       uwithin?
  146.       IF    data_start -  9 swap  EXIT
  147.       THEN
  148.  
  149.     0  0        ¥ search failed - return two zeros
  150. ;
  151.  
  152.  
  153. ¥ seg#>gpr# finds if the passed-in seg# corresponds to a base gpr.
  154. ¥  If so, it returns the reg#.  If not, it returns zero.
  155.  
  156. : seg#>gpr#        ¥ ( seg# -- gpr# )
  157.  
  158.     CASE[    8    ]=>        mainCode_reg    EXIT
  159.         [    9    ]=>        mainData_reg    EXIT
  160.         [    10    ]=>        modCode_reg        EXIT
  161.         [    11    ]=>        modData_reg        EXIT
  162.  
  163.     DEFAULT=>            drop  0
  164.     ]CASE
  165. ;
  166.  
  167.  
  168.  
  169. ¥ B&D takes the passed-in address and converts it to gpr# and displacement.
  170.  
  171. : (B&D) { theAddr ¥ seg# displ gpr# -- gpr# displ' }
  172.  
  173.     theAddr addr>S&D  -> displ -> seg#    ¥ both will be zero if theAddr is 
  174.                                         ¥  not in any segment
  175.                                             
  176.     seg# seg#>gpr#  -> gpr#                ¥ will be zero if we didn't get a reg
  177.  
  178.     gpr# mainCode_reg =
  179.     IF    mainCode_reg
  180.         displ code_start + nuc_code_start -  half_displ_range -
  181.         EXIT
  182.     THEN
  183.     
  184.     gpr# mainData_reg =
  185.     IF    mainData_reg
  186.         displ  data_start +  nuc_data_start -  half_displ_range -
  187.         EXIT
  188.     THEN
  189.                 
  190.     gpr#
  191.     IF    gpr#
  192.         displ half_displ_range -
  193.     ELSE            ¥ theAddr wasn't in range of any reg - return two zeros
  194.         0  0
  195.     THEN
  196. ;
  197.  
  198.  
  199. : B&D
  200.     (b&d) over
  201.     NIF    drop cr  .h ."   is an out-of-range addr!" 1 die  THEN
  202. ;
  203.  
  204.  
  205. ¥ @B&D fetches a relocatable addr and returns the "real" base
  206. ¥ gpr# and displacement.  This is used for going from the code
  207. ¥  area to the data area, for values etc.
  208.  
  209. : @B&D { addr ¥ relocAddr seg# displ gpr# -- gpr# displ' }
  210.     addr @  -> relocAddr
  211.     relocAddr  $ ffffff and  -> displ
  212.     relocAddr  24 >>  -> seg#
  213.  
  214.     seg# seg#>gpr#  -> gpr#
  215.     
  216.     gpr# mainCode_reg =
  217.     IF    mainCode_reg
  218.         displ code_start + nuc_code_start -  half_displ_range -
  219.         EXIT
  220.     THEN
  221.     
  222.     gpr# mainData_reg =
  223.     IF    mainData_reg
  224.         displ  data_start +  nuc_data_start -  half_displ_range -
  225.         EXIT
  226.     THEN
  227.                 
  228.     gpr#
  229.     IF    gpr#  displ half_displ_range -
  230.                     ¥ machine instrns use a signed displ, so we
  231.                     ¥  point base regs 32k above the seg start
  232.                                         
  233.     ELSE            ¥ seg# didn't refer to a loaded reg, or was just garbage
  234.         70 die        ¥ " not a reloc addr"
  235.     THEN
  236. ;
  237.  
  238. ¥                ===========================================
  239.  
  240.  
  241. $ 4E58    constant    xinfoMk
  242.  
  243.     0    value    tempObj_framesize    ¥ we don't target compile temp objects
  244.     0    value    releaseTemps_xt        ¥ since the code generator doesn't use
  245.                                     ¥ them, but I can use these value in
  246.                                     ¥ testing.  The "real" values are
  247.                                     ¥ defined in nuc1.
  248.  
  249. (* CFA_ADJUST fixes a cfa given to us by the 68k compiler to conform
  250.    to our PPC alignment convention, if necessary.  On the PPC, this
  251.    word will do nothing.  Once we're compiling PPC code, even on the
  252.    68k, FIND et al looks after this for us too.  So we only need to
  253.    do it if we're looking at the cfa of a PPC-format header while still
  254.    not compiling PPC code.
  255.  
  256.    We can always take care of whether the header is in 68k or PPC format
  257.    and give the right answer.  This is because on the PPC if we need 2 extra
  258.    pad bytes for alignment before the handler field, they're always zero,
  259.    while a handler field can NEVER be zero.  Thus if there's zero where the
  260.    handler field would have been on the 68k, and we weren't aligned, this MUST
  261.    be a PPC-style header.  If we were already aligned, the cfa wouldn't need
  262.    changing anyway.
  263. *)
  264.  
  265. : CFA_ADJUST  { cfa ¥ addr al-addr -- cfa' }
  266.     PPC? NIF  cfa  EXIT  THEN    ¥ not compiling PPC code - leave cfa unchanged
  267.  
  268.     cfa 2-  -> addr                ¥ back to handler field
  269.     addr #align4  -> al-addr    ¥ on the PPC this must be 4-byte aligned
  270.     addr al-addr <>                ¥ did we change it?
  271.     IF addr w@                    ¥ yes - was that a handler field or padding?
  272.         IF    cfa  EXIT  THEN        ¥ handler field.  It's 68k format.  Don't
  273.                                 ¥  change original cfa
  274.     THEN
  275.     al-addr 2+                    ¥ padding, or addr didn't change.  We return
  276. ;                                ¥  the aligned addr plus 2.
  277.  
  278.  
  279. : (PPC_HEADER)  { ¥ svDP -- }
  280.     PPC?
  281.     IF    code_align
  282.         DP -> svDP
  283.         CDP -> DP  header
  284.         DP -> CDP  svDP -> DP
  285.         code_align
  286.     ELSE
  287.         header  align4
  288.     THEN
  289. ;
  290.  
  291. : (ppc_sHdr)  { addr len ¥ svDP -- }
  292.     code_align
  293.     DP -> svDP
  294.     CDP -> DP  addr len sHdr
  295.     DP -> CDP  svDP -> DP
  296.     code_align
  297. ;
  298.  
  299. ' (ppc_header)  -> ppc_header
  300. ' (ppc_sHdr)    -> ppc_sHdr
  301.  
  302.  
  303. : 68kCall  db  ;
  304.  
  305.  
  306. ¥ USES_CTR is used like IMMEDIATE, and indicates that the defn just
  307. ¥  compiled uses the count register (which will disallow DO loops
  308. ¥  calling that defn from using the count reg as the loop counter).
  309. ¥  This is normally handled automatically, but for code definitions
  310. ¥  this word is useful.
  311.  
  312. : USES_CTR
  313.     $ 40  latest name> #off-align  cset  ;        immediate
  314.  
  315.  
  316. false    value    marker_there?
  317.  
  318. string+  $tmp
  319. string+  $marker
  320.  
  321.  
  322. : BL>01        ¥ ( addr len -- )  Replaces blanks with 01's in the string.
  323.     bounds
  324.     ?DO        i c@  bl = IF  $ 01  i c!  THEN
  325.     LOOP
  326. ;
  327.  
  328. : 01>BL        ¥ ( addr len -- )  Replaces 01's with blanks in the string.
  329.     bounds
  330.     ?DO        i c@  $ 01 = IF  bl  i c!  THEN
  331.     LOOP
  332. ;
  333.  
  334.  
  335. : FNAME>MNAME    ¥ ( addr len -- )    Takes the passed-in filename, and converts it to
  336.                 ¥  the corresponding file marker name in $marker.
  337.  
  338.     new: $marker  put: $marker
  339.     & :  <chsearch: $marker  negate skip: $marker
  340.     <step: $marker  delete: $marker
  341.     all: $marker bl>01            ¥ replace any blanks
  342.     begin: $marker  " m__" insert: $marker        ¥ prepend "m__"
  343.     reset: $marker
  344. ;
  345.  
  346. : MNAME>FNAME    ¥ ( addr len -- )    Takes the passed-in marker name, and
  347.                 ¥  converts it to  the corresponding filename in  $marker.
  348.     3 /string                                ¥ skip the "m__"
  349.     new: $marker  put: $marker  all: $marker 01>bl    ¥ and recover any blanks
  350.     reset: $marker
  351. ;
  352.  
  353. 0    value    mk_cfa
  354.  
  355. :f PPC_mark_file  { addr len ¥ rc -- }
  356.  
  357.     " marker" sFind  nip  0EXIT        ¥ out if MARKER not defined yet
  358.  
  359.     addr len fname>mname
  360.     begin: $marker  " marker " insert: $marker
  361.     lock: $marker  all: $marker  evaluate
  362.     release: $marker
  363.     true -> marker_there?
  364.     CDP 10 -  -> mk_cfa
  365.     1 mk_cfa w!                        ¥ store 1 in word at cfa to show
  366.                                     ¥  this is a file mark
  367.                                     
  368.     getFileInfo: topfile -> rc
  369.     topFile 48 + @  code,            ¥ put source dirID after marker info
  370.                                     ¥  at offs 10 from cfa
  371.     topFile 76 + @  code,            ¥ then the mod date at offs 14
  372.     getName: topfile                ¥ this will be the full pathname
  373.     dup -> len
  374.     CDP place  len 1+ ++> CDP        ¥ store it after the mod date,
  375.                                     ¥  at offs 18
  376.     code_align
  377.  
  378. ;f
  379.  
  380.